home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
REFERENC
/
TPR
/
SOURCE.EXE
/
DEMOLIST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-08-07
|
6KB
|
243 lines
{ DEMOLIST.PAS }
program DemoList;
{
Demonstrates the use of pointers to create a list structure, demonstrates how
list traversal is done in both forwards and backwards directions, and provides
routines to add (or insert) and delete items in the list.
You can modify these routines for use as a general purpose list manipulation
tool, by changing the ListEntry data structure to hold other types of data.
This demonstration program uses the Dos library routines FindFirst and
FindNext to read the default file subdirectory.
}
uses Dos;
type
{ Data record to create the list structure }
PListEntry = ^TListEntry;
TListEntry = record
DirInfo : SearchRec;
Next : PListEntry;
Previous: PListEntry;
end; {TListEntry}
var
ListHead : PListEntry;
ListTail : PListEntry;
function LowerCase (S : String ) : String;
Var
I : Integer;
begin
for I := 1 to length(s) do
if ((S[I]>='A') and (S[I]<='Z')) then
S[I] := Chr( Ord( S[I] ) + 32 );
LowerCase := S;
end;
procedure InitDirectoryList;
{ Initialize the directory list structure.
For convenience, the first entry contains the default volumne name C:\.
}
begin
ListHead := New(PListEntry);
ListHead^.Next := NIL;
ListHead^.Previous := NIL;
ListTail := ListHead;
ListHead^.DirInfo.Name := 'C:\';
end; {InitDirectoryList}
function AddEntry ( Location : PListEntry;
Var ListEntry : SearchRec ) : PListEntry;
Var
NewEntry : PListEntry;
SavedNext : PListEntry;
begin
NewEntry := New ( PListEntry );
NewEntry^.DirInfo := ListEntry;
If Location = ListTail Then
{Adding an item on to the tail of the list}
begin
NewEntry^.Next := NIL;
NewEntry^.Previous := ListTail;
ListTail^.Next := NewEntry;
ListTail := NewEntry;
end
else
{inserting an item within the list}
begin
SavedNext := Location^.Next;
Location^.Next := NewEntry;
NewEntry^.Next := SavedNext;
NewEntry^.Previous := Location;
SavedNext^.Previous := NewEntry;
end;{begin}
AddEntry := NewEntry;
end;{AddEntry}
function RemoveEntry ( Location : PListEntry;
HowMany : Integer ) : PListEntry;
{ Starting at the point in the list indicated by 'Location', delete
'HomeMany' entries from the list.
Return: A pointer to the first item after those that were deleted.
}
var
CountOfItems : Integer;
function DeleteEntry ( Location : PListEntry ) : PListEntry;
begin
if Location <> NIL then
begin
If Location^.Previous <> NIL Then
Location^.Previous^.Next := Location^.Next;
If Location^.Next <> NIL Then
Location^.Next^.Previous := Location^.Previous;
DeleteEntry := Location^.Next;
If Location = ListTail Then
ListTail := Location^.Previous;
Dispose(Location);
end
else
DeleteEntry := NIL;
end;
begin {RemoveEntry}
For CountOfItems := 1 to HowMany Do
Location := DeleteEntry ( Location );
RemoveEntry := Location;
end;{RemoveEntry}
function Move_Fwd ( Location : PListEntry;
HowFar : Integer ) : PListEntry;
{Starting from 'location' move ahead 'HowFar' items in the list
and return the new location
}
Var
I : Integer;
begin
For I := 1 to HowFar Do
If Location^.Next <> NIL Then
Location := Location^.Next;
Move_Fwd := Location;
end;{Move_Fwd}
function Move_Bwd ( Location : PListEntry;
HowFar : Integer ) : PListEntry;
{Starting from 'location' move backwards 'HowFar' items in the list
and return that new location
}
var
I : Integer;
begin
for I := 1 to HowFar do
if Location^.Previous <> NIL Then
Location := Location^.Previous;
Move_Bwd := Location;
end;{Move_Bwd}
Procedure DisplayFwdList;
Var
TempPtr : PListEntry;
begin
TempPtr := ListHead;
While TempPtr <> NIL do
begin
writeln(TempPtr^.dirinfo.name);
tempptr := TempPtr^.Next;
end;
end;
procedure DisplayBwdList;
Var
TempPtr : PListEntry;
begin
TempPtr := ListTail;
while TempPtr <> NIL do
begin
writeln (TempPtr^.dirinfo.name);
tempptr := TempPtr^.Previous;
end;
end;
procedure ReadDirectory
( StartingEntry : PListEntry );
{ Purpose:
Reads the directory contents and inserts
the list into the directory list beginning at 'StartingEntry'.
}
var
ListEntry : SearchRec; { Holds the contents of a directory entry
consisting of filename, size, etc }
CurLocation : PListEntry;
IsADirectory : Boolean;
begin
{Call FindFirst to locate all files. The '*.*' matches all filenames,
In this case we want to see ALL files so we use the AnyFile mask.
Note that for the purpose of this example program we are not doing
error checking. We should check the DosError variable after each
call to FindFirst and FindNext. Also, its possible that AddEntry
will run of memory and return a NIL value but we aren't checking
for that in this simplified application example.
}
FindFirst( '*.*', AnyFile, ListEntry );
while DosError = 0 do
begin
if ListEntry.Name[1] <> '.' then
{Add all names other than those beginning with '.'. This
eliminates our displaying the '.' and '..' names used by DOS}
begin
IsADirectory := (ListEntry.Attr and Directory) = Directory;
if not IsADirectory then
ListEntry.Name := LowerCase (ListEntry.Name);
{We convert file names to lowercase and leave directory names
in upper case for ease of reading the directory listing}
StartingEntry := AddEntry ( StartingEntry, ListEntry );
end; { begin }
FindNext( ListEntry );
end; { begin }
end; { ReadDirectory }
begin
InitDirectoryList;
ReadDirectory ( ListHead );
DisplayFwdList;
Readln;
DisplayBwdList;
Readln;
end.